#!/usr/bin/env perl -w
# Time-stamp: <29 Feb 00 13:25:29 giron1> 

=head1 NAME

htk2sidl.perl - HTK grammar to SIDL converter -

=head1 DESCRIPTION

convert htk grammar to sidl grammar format (xml)

=head1 AUTHOR

 Thomas Kempt
 $Id: htk2sidl.perl,v 1.1 2007/10/08 09:26:04 schweitz Exp $

=head1 LOG

$Log: htk2sidl.perl,v $
Revision 1.1  2007/10/08 09:26:04  schweitz
version 2.4, lib vergessen

Revision /main/3  22-Jan-2003.10:04:04  giron1
Changing header to /usr/bin/env perl.

Revision 1.2  2000/03/01 17:26:50  giron1
Creation of HTML

Revision 1.1  2000/02/16 10:16:20  giron1
Extended original program from Thomas Kemp to take care of variables defined on many lines.


Revision 1.5  2000/01/18 13:57:36  kempt1
now correctly handles the main expression

Revision 1.4  2000/01/18 10:23:18  kempt1
Added a silly missing / to the referencing of srglrefs

Revision 1.3  2000/01/17 10:07:29  kempt1
Improved RCS log message handling

=cut


# --------------------------------------------------------------

if ($#ARGV < 1 || $ARGV[0] eq "-h") {
  warn "Usage: perl <this script> <name of htk grammar source file> <language iso code>\n";
  exit;
}

# -----------------------------------------------------------
# global variables and definitions
# -----------------------------------------------------------
$INDENTMAX = 12;
$language = "deu";
$INDENT = 1;

$indent_printed = 0;

$sourcefile = shift(@ARGV);
$language = shift(@ARGV);

if ($sourcefile ne "--") {
  open(FP,$sourcefile) || die "Could not open $sourcefile !\n";
  $handle = "FP";
} else {
  $handle = "STDIN";
}
if ($language eq '') {die "which language should be used ?\n";}

print "<?xml version='1.0' encoding='ISO-8859-1'?>\n";
print "<!DOCTYPE sidl SYSTEM \"sidl.dtd\">\n";
print "<sidl>\n\n";


# -----------------------------------------------------------
# toplevel expression
# SIDL defines that the first srgl is the toplevel expression
# so lets find it and put it right in the beginning
# -----------------------------------------------------------

while ($line = <$handle>) {
  if ($line =~ m/^\((.*)\)/) {
    $definestring = $1;
    print "<srgl id=\"main\" language=\"${language}\">";
    &parse($definestring . ";",$INDENT);
    print "</srgl>\n\n";
  }
}

if ( (seek $handle,0,0) == 0 ) { die "ERROR trying to rewind - exiting\n"; } 

# ------------------------------------------------------------
# parsing the expressions
# ------------------------------------------------------------
    
while ($line = <$handle>) {
  # -----------------------------------------------------------
  # handle comments and empty lines
  # -----------------------------------------------------------
  next if ($line =~ m/^\#.*/ or $line =~ m/^\s*$/);

  # -----------------------------------------------------------
  # handle definitions of variables
  # -----------------------------------------------------------
  if ($line =~ m/^\$.*/) {
    $line =~ m/^\$([^\s=]*)[^=]*=[\s]*(.*)/;
    $category = $1;
    $definestring = $2;
  } elsif ($line =~ m/^\s*(.*)/) {
    $definestring .= $1;
  }
  # ------------------------------------------------------------
  # search end of expressions with ;
  # ------------------------------------------------------------
  if ($definestring =~ m/.*;/) {
    print "<srgl id=\"${category}\" language=\"${language}\">";
    &parse($definestring,$INDENT);
    print "</srgl>\n\n";
  }
}
if ($handle ne "STDIN") { close("$handle"); }

print "</sidl>\n\n";

exit;

sub parse {
  my ($string) = shift;
  my ($indent_level) = shift;
  my ($indentstring);
  my ($i,@words);

  # handle indentation
  if ($indent_level > $INDENTMAX) { $indent_level = $INDENTMAX ; }
  $indentstring = substr("                                ",0,$indent_level);

  # replace all [,],|,(,) bei <space> <sign> <space>
  $string =~ s/\[/ \[ /g;
  $string =~ s/\]/ \] /g;
  $string =~ s/\(/ \( /g;
  $string =~ s/\)/ \) /g;
  $string =~ s/\|/ \| /g;
  $string =~ s/;/ ; /g;
  $string =~ y/ //s;
  $string =~ s/^ //;

  # warn "string: $string\n";
  # warn "indent_level:$indent_level\n";

  print "\n${indentstring}<alt>"; $indent_printed = 0;
  $indent_level += $INDENT; 
  
 LOOP:
  @words = split(/[\s]+/, $string);

 LOOP1:
  if ($#words < 0) { 
    die "Syntax error: no ; terminates line!\n"; 
  }
  # end of current line!
  if ($words[0] eq ";" ) {
    $indent_level -= $INDENT;
    $indentstring = substr($indentstring,0,$indent_level);
    print "\n${indentstring}</alt>\n"; $indent_printed = 0;
    return ; 
  }

  # end of optional expression?
  if ($words[0] eq "]" or $words[0] eq ")") { 
    $indent_level -= $INDENT;
    $indentstring = substr($indentstring,0,$indent_level);
    # empty </div> gives the optionality in the case of []
    if ($words[0] eq "]") {print " <div/>";}
    print "\n${indentstring}</alt>"; $indent_printed = 0;
    # no need to finish the alternative with a <div/>, as the final
    # </alt> seems to serve as a delimiter just as <div/> does...
    return ; 
  }

  # ----------------------------
  # handle optional expressions
  # ----------------------------
  if ($words[0] eq "[" or $words[0] eq "(") {
    # search for end:
    $substring = "";
    my ($level) = 0;
    for ($i=1; $i <= $#words; $i++) { 
      if ($words[$i-1] eq "]" or $words[$i-1] eq ")") { $level--; }
      if ($words[$i-1] eq "[" or $words[$i-1] eq "(") { $level++; }
      $substring = $substring . $words[$i] . " ";
      last if ($level == 0);
    } 
    if ($i > $#words) {
      warn "Syntax error in string '$string' : [ or ( not terminated!\n";
      exit;
    }
    $indent_printed = 0;
    &parse($substring,$indent_level+$INDENT);
    $string = "";
    
    for (;$i <= $#words; $i++) {
      $string .= $words[$i] . " ";
    }
    goto LOOP;
  }
  # ----------------------------------------------
  # the current expression is not an optional one 
  # maybe it is an alternative (|) or a literal?
  # ----------------------------------------------
  if ($words[0] eq "|") {
    # it is an alternative!
    shift(@words);
    print " <div/>"; $indent_printed = 0;
    goto LOOP1;
  }

  # a literal or reference!
  if ($indent_printed == 0) { print "\n"; print substr($indentstring,1); $indent_printed = 1; }
  
  if ($words[0] =~ m/^\$(.*)/) {
    print " <srglref target=\"$1\"/>";
  } else {
    print " $words[0]";
  }
  
  shift(@words);
  goto LOOP1;

}
